home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 2000 October / Software of the Month - Ultimate Collection Shareware 277.iso / pc / PROGRAMS / UTILITY / WINLINUX / DATA1.CAB / usr_-_Usr_Files / SBIN / DPKG-DIV.{3R < prev    next >
Text File  |  1999-09-17  |  8KB  |  225 lines
  1. #! /usr/bin/perl --
  2.  
  3. #use POSIX; &ENOENT;
  4. sub ENOENT { 2; }
  5. # Sorry about this, but POSIX.pm isn't necessarily available
  6.  
  7. $version="1.4.0.34"; # This line modified by Makefile
  8. sub usageversion {
  9.     print(STDERR <<END)
  10. Debian GNU/Linux dpkg-divert $version.  Copyright (C) 1995
  11. Ian Jackson.  This is free software; see the GNU General Public Licence
  12. version 2 or later for copying conditions.  There is NO warranty.
  13.  
  14. Usage:
  15.  dpkg-divert [options] [--add] <file>
  16.  dpkg-divert [options] --remove <file>
  17.  dpkg-divert [options] --list [<glob-pattern>]
  18.  
  19. Options:  --package <package> | --local  --divert <divert-to>  --rename
  20.           --quiet  --test  --help|--version  --admindir <directory>
  21.  
  22. <package> is the name of a package whose copy of <file> will not be diverted.
  23. <divert-to> is the name used by other packages' versions.
  24. --local specifies that all packages' versions are diverted.
  25. --rename causes dpkg-divert to actually move the file aside (or back).
  26.  
  27. When adding, default is --local and --divert <original>.distrib.
  28. When removing, --package or --local and --divert must match if specified.
  29. Package preinst/postrm scripts should always specify --package and --divert.
  30. END
  31.         || &quit("failed to write usage: $!");
  32. }
  33.  
  34. $admindir= '/var/lib/dpkg';
  35. $testmode= 0;
  36. $dorename= 0;
  37. $verbose= 1;
  38. $mode='';
  39. $|=1;
  40.  
  41. sub checkmanymodes {
  42.     return unless $mode;
  43.     &badusage("two modes specified: $_ and --$mode");
  44. }
  45.  
  46. while (@ARGV) {
  47.     $_= shift(@ARGV);
  48.     last if m/^--$/;
  49.     if (!m/^-/) {
  50.         unshift(@ARGV,$_); last;
  51.     } elsif (m/^--(help|version)$/) {
  52.         &usageversion; exit(0);
  53.     } elsif (m/^--test$/) {
  54.         $testmode= 1;
  55.     } elsif (m/^--rename$/) {
  56.         $dorename= 1;
  57.     } elsif (m/^--quiet$/) {
  58.         $verbose= 0;
  59.     } elsif (m/^--local$/) {
  60.         $package= ':';
  61.     } elsif (m/^--add$/) {
  62.         &checkmanymodes;
  63.         $mode= 'add';
  64.     } elsif (m/^--remove$/) {
  65.         &checkmanymodes;
  66.         $mode= 'remove';
  67.     } elsif (m/^--list$/) {
  68.         &checkmanymodes;
  69.         $mode= 'list';
  70.     } elsif (m/^--divert$/) {
  71.         @ARGV || &badusage("--divert needs a divert-to argument");
  72.         $divertto= shift(@ARGV);
  73.         $divertto =~ m/\n/ && &badusage("divert-to may not contain newlines");
  74.     } elsif (m/^--package$/) {
  75.         @ARGV || &badusage("--package needs a package argument");
  76.         $package= shift(@ARGV);
  77.         $divertto =~ m/\n/ && &badusage("package may not contain newlines");
  78.     } elsif (m/^--admindir$/) {
  79.         @ARGV || &badusage("--admindir needs a directory argument");
  80.         $admindir= shift(@ARGV);
  81.     } else {
  82.         &badusage("unknown option \`$_'");
  83.     }
  84. }
  85.  
  86. $mode='add' unless $mode;
  87.  
  88. open(O,"$admindir/diversions") || &quit("cannot open diversions: $!");
  89. while(<O>) {
  90.     s/\n$//; push(@contest,$_);
  91.     $_=<O>; s/\n$// || &badfmt("missing altname");
  92.     push(@altname,$_);
  93.     $_=<O>; s/\n$// || &badfmt("missing package");
  94.     push(@package,$_);
  95. }
  96. close(O);
  97.  
  98. if ($mode eq 'add') {
  99.     @ARGV == 1 || &badusage("--add needs a single argument");
  100.     $file= $ARGV[0];
  101.     $file =~ m/\n/ && &badusage("file may not contain newlines");
  102.     -d $file && &badusage("Cannot divert directories");
  103.     $divertto= "$file.distrib" unless defined($divertto);
  104.     $package= ':' unless defined($package);
  105.     for ($i=0; $i<=$#contest; $i++) {
  106.         if ($contest[$i] eq $file || $altname[$i] eq $file ||
  107.             $contest[$i] eq $divertto || $altname[$i] eq $divertto) {
  108.             if ($contest[$i] eq $file && $altname[$i] eq $divertto &&
  109.                 $package[$i] eq $package) {
  110.                 print "Leaving \`",&infon($i),"'\n" if $verbose > 0;
  111.                 exit(0);
  112.             }
  113.             &quit("\`".&infoa."' clashes with \`".&infon($i)."'");
  114.         }
  115.     }
  116.     push(@contest,$file);
  117.     push(@altname,$divertto);
  118.     push(@package,$package);
  119.     print "Adding \`",&infon($#contest),"'\n" if $verbose > 0;
  120.     &checkrename($file,$divertto);
  121.     &save;
  122.     &dorename($file,$divertto);
  123.     exit(0);
  124. } elsif ($mode eq 'remove') {
  125.     @ARGV == 1 || &badusage("--remove needs a single argument");
  126.     $file= $ARGV[0];
  127.     for ($i=0; $i<=$#contest; $i++) {
  128.         next unless $file eq $contest[$i];
  129.         &quit("mismatch on divert-to\n  when removing \`".&infoa."'\n  found \`".
  130.               &infon($i)."'") if defined($divertto) && $altname[$i] ne $divertto;
  131.         &quit("mismatch on package\n  when removing \`".&infoa."'\n  found \`".
  132.               &infon($i)."'") if defined($package) && $package[$i] ne $package;
  133.         print "Removing \`",&infon($i),"'\n" if $verbose > 0;
  134.         $orgfile= $contest[$i];
  135.         $orgdivertto= $altname[$i];
  136.         @contest= (($i > 0 ? @contest[0..$i-1] : ()),
  137.                    ($i < $#contest ? @contest[$i+1..$#contest] : ()));
  138.         @altname= (($i > 0 ? @altname[0..$i-1] : ()),
  139.                    ($i < $#altname ? @altname[$i+1..$#altname] : ()));
  140.         @package= (($i > 0 ? @package[0..$i-1] : ()),
  141.                    ($i < $#package ? @package[$i+1..$#package] : ()));
  142.         &checkrename($orgdivertto,$orgfile);
  143.         &dorename($orgdivertto,$orgfile);
  144.         &save;
  145.         exit(0);
  146.     }
  147.     print "No diversion \`",&infoa,"', none removed\n" if $verbose > 0;
  148.     exit(0);
  149. } elsif ($mode eq 'list') {
  150.     @ilist= @ARGV ? @ARGV : ('*');
  151.     while (defined($_=shift(@ilist))) {
  152.         s/\W/\\$&/g;
  153.         s/\\\?/./g;
  154.         s/\\\*/.*/g;
  155.         push(@list,"^$_\$");
  156.     }
  157.     $pat= join('$|^',@list);
  158.     for ($i=0; $i<=$#contest; $i++) {
  159.         next unless ($contest[$i] =~ m/$pat/o ||
  160.                      $altname[$i] =~ m/$pat/o ||
  161.                      $package[$i] =~ m/$pat/o);
  162.         print &infon($i),"\n";
  163.     }
  164.     exit(0);
  165. } else {
  166.     &quit("internal error - bad mode \`$mode'");
  167. }
  168.  
  169. sub infol {
  170.     return (($_[2] eq ':' ? "local " : length($_[2]) ? "" : "any ").
  171.             "diversion of $_[0]".
  172.             (length($_[1]) ? " to $_[1]" : "").
  173.             (length($_[2]) && $_[2] ne ':' ? " by $_[2]" : ""));
  174. }
  175.  
  176. sub checkrename {
  177.     return unless $dorename;
  178.     ($rsrc,$rdest) = @_;
  179.     (@ssrc= lstat($rsrc)) || $! == &ENOENT ||
  180.         &quit("cannot stat old name \`$rsrc': $!");
  181.     (@sdest= lstat($rdest)) || $! == &ENOENT ||
  182.         &quit("cannot stat new name \`$rdest': $!");
  183.     if (@ssrc && @sdest &&
  184.         !($ssrc[0] == $sdest[0] && $ssrc[1] == $sdest[1])) {
  185.         &quit("rename involves overwriting \`$rdest' with\n".
  186.               "  different file \`$rsrc', not allowed");
  187.     }
  188. }
  189.  
  190. sub dorename {
  191.     return unless $dorename;
  192.     return if $testmode;
  193.     if (@ssrc) {
  194.         if (@sdest) {
  195.             unlink($rsrc) || &quit("rename: remove duplicate old link \`$rsrc': $!");
  196.         } else {
  197.             rename($rsrc,$rdest) || &quit("rename: rename \`$rsrc' to \`$rdest': $!");
  198.         }
  199.     }
  200. }            
  201.     
  202. sub save {
  203.     return if $testmode;
  204.     open(N,"> $admindir/diversions-new") || &quit("create diversions-new: $!");
  205.     chmod 0644, "$admindir/diversions-new";
  206.     for ($i=0; $i<=$#contest; $i++) {
  207.         print(N "$contest[$i]\n$altname[$i]\n$package[$i]\n")
  208.             || &quit("write diversions-new: $!");
  209.     }
  210.     close(N) || &quit("close diversions-new: $!");
  211.     unlink("$admindir/diversions-old") ||
  212.         $! == &ENOENT || &quit("remove old diversions-old: $!");
  213.     link("$admindir/diversions","$admindir/diversions-old") ||
  214.         $! == &ENOENT || &quit("create new diversions-old: $!");
  215.     rename("$admindir/diversions-new","$admindir/diversions")
  216.         || &quit("install new diversions: $!");
  217. }
  218.  
  219. sub infoa { &infol($file,$divertto,$package); }
  220. sub infon { &infol($contest[$i],$altname[$i],$package[$i]); }
  221.  
  222. sub quit { print STDERR "dpkg-divert: @_\n"; exit(2); }
  223. sub badusage { print STDERR "dpkg-divert: @_\n\n"; &usageversion; exit(2); }
  224. sub badfmt { &quit("internal error: $admindir/diversions corrupt: $_[0]"); }
  225.